home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / sml_nj / 93src.lha / src / mips / mipsmc.sml < prev   
Encoding:
Text File  |  1993-01-27  |  6.9 KB  |  194 lines
  1. structure KeepMipsMCode : sig
  2.                   val code : ByteArray.bytearray ref
  3.                   val getCodeString : unit -> string
  4.                   val cleanup : unit -> unit
  5.               end =
  6. struct
  7.     open ByteArray
  8.     val code = ref (array(0,0))
  9.     fun getCodeString () = let val s = extract (!code, 0, length (!code))
  10.                in 
  11.                    code := array(0, 0); s
  12.                end
  13.     fun cleanup () = code := array(0,0)
  14. end
  15.     
  16. functor MipsMCode(structure E : ENDIAN) : EMITTER = struct
  17.  
  18.   structure M = MipsInstrSet 
  19.   structure K = KeepMipsMCode
  20.   open M
  21.  
  22.   val error = ErrorMsg.impossible
  23.  
  24.   val << = Bits.lshift
  25.   val >> = Bits.rshift
  26.   val || = Bits.orb
  27.   val &  = Bits.andb
  28.   infix << >> || &
  29.  
  30.   val loc = ref 0
  31.  
  32.   fun init n = (K.code := ByteArray.array(n, 0); loc := 0)
  33.  
  34.   fun emitByte n = let val i = !loc
  35.            in
  36.                loc := i + 1; ByteArray.update (!K.code, i, n)
  37.            end
  38.  
  39.   fun emitHiLo(hi,lo) = let
  40.         val (byte0,byte1,byte2,byte3) = E.wordLayout (hi,lo)
  41.       in  
  42.       emitByte byte0;
  43.       emitByte byte1;
  44.       emitByte byte2;
  45.       emitByte byte3
  46.       end
  47.  
  48.   fun emitLong n = emitHiLo((n >> 16) & 65535, n & 65535)
  49.  
  50.   fun emitString s = let
  51.     fun copy i = (emitByte(ordof(s, i)); copy(i+1))
  52.     in
  53.       (copy 0) handle Ord => ()
  54.     end
  55.  
  56.   exception BadReal = IEEEReal.BadReal
  57.   val emitReal = emitString o E.order_real o IEEEReal.realconst
  58.  
  59.   fun emitAddr (INFO{addrOf,...}) (lab,k) = emitLong (k + addrOf lab - !loc)
  60.  
  61.   fun define _ _ = ()
  62.  
  63.   local open System.Tags
  64.   in
  65.       fun mark() = emitLong(make_desc((!loc + 4)>>2,tag_backptr))
  66.   end
  67.  
  68.   fun comment _ = ()
  69.  
  70.   fun emitInstr info =
  71.   let val labelValue = M.labelValue info
  72.      val hiLabelValue = M.hiLabelValue info
  73.      val loLabelValue = M.loLabelValue info
  74.      val labBranchOff = M.labBranchOff info
  75.  
  76.     (* order of operands is identical to instr. format layout *)
  77.  
  78.       fun R_Type(opcode,rs',rt',rd',shamt,func) = 
  79.       case (reg_rep rs', reg_rep rt', reg_rep rd')
  80.        of  (Reg' rs, Reg' rt, Reg' rd) =>
  81.            emitHiLo((opcode << 10) || (rs << 5) || rt,
  82.             (rd << 11) || (shamt << 6) || func)
  83.         | _ => error "MipsMCode.R_Type:"
  84.  
  85.       fun I_Type(opcode,rs',rt',immed) = 
  86.       case (reg_rep rs', reg_rep rt')
  87.        of (Reg' rs, Reg' rt) =>
  88.             emitHiLo((opcode << 10) || (rs << 5) || rt, immed)
  89.         | _ => error "MipsMCode.I_Type:"
  90.  
  91.       fun J_Type(opcode,target) = let
  92.             val targetHi = (target >> 16) & 1023
  93.         val targetLo = target & 65535
  94.       in
  95.           emitHiLo((opcode << 10) || targetHi, targetLo)
  96.       end
  97.  
  98.       fun R_Type_f(opcode,format,ft',fs',fd',func) = 
  99.       case (reg_rep ft', reg_rep fs', reg_rep fd')
  100.        of (Freg' ft, Freg' fs, Freg' fd) =>
  101.            emitHiLo((opcode << 10) || (format << 5) ||  ft,
  102.             (fs << 11) || (fd << 6) || func)
  103.         | _ => error "MipsMCode.R_Type_f"
  104.  
  105.       fun I_Type_f(opcode,base',ft',immed) = 
  106.       case (reg_rep base', reg_rep ft') 
  107.         of (Reg' base, Freg' ft) =>
  108.           emitHiLo((opcode << 10) || (base << 5) || ft, immed)
  109.          | _ => error "MipsMCode.I_Type_f:"      
  110.       
  111.       fun immediate_arith (Immed16Op n)    = M.chk_immed16 n
  112.     | immediate_arith (LabelOp labexp) = M.chk_immed16(labelValue labexp)
  113.     | immediate_arith (HiLabOp labexp) = hiLabelValue labexp
  114.     | immediate_arith (LoLabOp labexp) = loLabelValue labexp
  115.     | immediate_arith _ = error "MipsMCode.immediate_arith"
  116.  
  117.       fun immediate_mem (Immed16Off n) = M.chk_immed16 n
  118.     | immediate_mem (LabOff labexp) = M.chk_immed16(labelValue labexp)
  119.     | immediate_mem (HiLabOff labexp) = hiLabelValue labexp
  120.     | immediate_mem (LoLabOff labexp) = loLabelValue labexp
  121.  
  122.       fun immediate_branch (opnd as LabOff labexp) = let
  123.         val labOff = labBranchOff opnd 
  124.           in
  125.           labOff - ((!loc + 4) >> 2)
  126.           end
  127.     | immediate_branch _ = error "MipsMCode.immdiate_branch: bad label"
  128.   in
  129.       fn NOP             => emitHiLo(0,0)
  130.  
  131.        | SLT(rd,rs,RegOp rt)  => R_Type(0,rs,rt,rd,0,42)
  132.        | SLT(rt,rs,opnd)      => I_Type(10,rs,rt,immediate_arith opnd)
  133.        | SLTU(rd,rs,RegOp rt) => R_Type(0,rs,rt,rd,0,43)
  134.        | SLTU(rt,rs,opnd)     => I_Type(11,rs,rt,immediate_arith opnd)
  135.  
  136.        | SLT_DOUBLE(fs,ft)    => R_Type_f(17,17,ft,fs,Freg 0,60)
  137.        | SEQ_DOUBLE(fs,ft)    => R_Type_f(17,17,ft,fs,Freg 0,58)
  138.  
  139.        | JUMP rs           => R_Type(0,rs,Reg 0,Reg 0,0,0x8)
  140.        | BLTZAL()              => I_Type(1,Reg 0,Reg 0x11,1)
  141.        | BEQ(true,rs,rt,opnd)  => I_Type(0x4,rs,rt,immediate_branch opnd)
  142.        | BEQ(false,rs,rt,opnd) => I_Type(0x5,rs,rt,immediate_branch opnd)
  143.        | BCOP1(true, opnd)     => I_Type_f(17,Reg 8,Freg 1,immediate_branch opnd)
  144.        | BCOP1(false, opnd)    => I_Type_f(17,Reg 8,Freg 0,immediate_branch opnd)
  145.  
  146.        | ADD(rd,rs,RegOp rt)  => R_Type(0,rs,rt,rd,0,0x20)
  147.        | ADD(rt,rs,opnd)      => I_Type(8,rs,rt,immediate_arith opnd)
  148.        | ADDU(rd,rs,RegOp rt) => R_Type(0,rs,rt,rd,0,0x21)
  149.        | ADDU(rt,rs,opnd)     => I_Type(9,rs,rt,immediate_arith opnd)
  150.        | AND(rd,rs,RegOp rt)  => R_Type(0,rs,rt,rd,0,0x24)
  151.        | AND(rt,rs,opnd)      => I_Type(12,rs,rt,immediate_arith opnd)
  152.        | OR(rd,rs,RegOp rt)   => R_Type(0,rs,rt,rd,0,0x25)
  153.        | OR(rt,rs,opnd)       => I_Type(13,rs,rt,immediate_arith opnd)
  154.        | XOR(rd,rs,RegOp rt)  => R_Type(0,rs,rt,rd,0,0x26)
  155.        | XOR(rt,rs,opnd)      => I_Type(14,rs,rt,immediate_arith opnd)
  156.        | SUB(rd,rs,rt)        => R_Type(0,rs,rt,rd,0,0x22)
  157.  
  158.        | MULT(rs,rt)     => R_Type(0,rs,rt,Reg 0,0,0x18)
  159.        | DIV(rs,rt)      => R_Type(0,rs,rt,Reg 0,0,0x1a)
  160.        | MFHI rd         => R_Type(0,Reg 0,Reg 0,rd,0,0x10)
  161.        | MFLO rd         => R_Type(0,Reg 0,Reg 0,rd,0,0x12)
  162.        | BREAK n         => R_Type(0,Reg 0,Reg n,Reg 0,0,13)
  163.  
  164.        | ADD_DOUBLE(fd,fs,ft) => R_Type_f(17,17,ft,fs,fd,0)
  165.        | SUB_DOUBLE(fd,fs,ft) => R_Type_f(17,17,ft,fs,fd,1)
  166.        | MUL_DOUBLE(fd,fs,ft) => R_Type_f(17,17,ft,fs,fd,2)
  167.        | DIV_DOUBLE(fd,fs,ft) => R_Type_f(17,17,ft,fs,fd,3)
  168.        | MOV_DOUBLE(fd,fs)    => R_Type_f(17,17,Freg 0,fs,fd,6)
  169.        | NEG_DOUBLE(fd,fs)    => R_Type_f(17,17,Freg 0,fs,fd,7)
  170.        | ABS_DOUBLE(fd,fs)    => R_Type_f(17,17,Freg 0,fs,fd,5)
  171.        | CVTI2D(fd,fs)        => R_Type_f(17,20,Freg 0,fs,fd,0x21)
  172.        | MTC1(rt,fs)      => 
  173.               (case reg_rep rt
  174.             of Reg' rt' => R_Type_f(17,4, Freg rt',fs,Freg 0,0)
  175.              | _ => error "MipsMCode.emitInstr: MTC1")
  176.  
  177.        | LBU(rt,base,opnd)  => I_Type(0x24,base,rt,immediate_mem opnd)
  178.        | SB(rt,base,opnd)   => I_Type(0x28,base,rt,immediate_mem opnd)
  179.        | LW(rt,base,opnd)   => I_Type(0x23,base,rt,immediate_mem opnd)
  180.        | SW(rt,base,opnd)   => I_Type(0x2b,base,rt,immediate_mem opnd)
  181.        | LWC1(ft,base,opnd) => I_Type_f(0x31,base,ft,immediate_mem opnd)
  182.        | SWC1(ft,base,opnd) => I_Type_f(0x39,base,ft,immediate_mem opnd)    
  183.        | LUI(rt,opnd)       => I_Type(0xf,Reg 0,rt,immediate_mem opnd)
  184.  
  185.        | SLL(rd,rt,Int5 n) => R_Type(0,Reg 0,rt,rd,n,0)
  186.        | SLLV(rd,rt,rs)    => R_Type(0,rs,rt,rd,0,4)         (* weird! *)
  187.        | SRA(rd,rt,Int5 n) => R_Type(0,Reg 0,rt,rd,n,3)
  188.        | SRAV(rd,rt,rs)    => R_Type(0,rs,rt,rd,0,7)         (* weird! *)
  189.   end (* local *)
  190.  
  191. end
  192.  
  193.  
  194.